Roadway and footpath data for Cook County were obtained from
OpenStreetMap, and GTFS feeds for public transportation (timetables,
routes, and service details) were downloaded from the CTA, Metra, and
PACE websites. These inputs were used in r5r to build a multimodal
routing network. Trip parameters included a maximum walking time of 30
minutes, maximum total travel time of 2 hours, and a departure window of
November 19, 2025 at 09:00 ± 10 minutes. Origins were defined as
population centroids of each census block group, and destinations as all
level I trauma centers.
For each origin–destination pair, r5r generated multiple feasible
public transit itineraries. Average travel time, wait time, walking
time, number of transfers, and number of modal “legs” (walk, bus, train)
were calculated by aggregating across all itineraries within the time
window. Drive times were estimated separately using the road network,
assuming typical traffic for the specified departure time.
Because this process produced a very large set of origin–destination
combinations, each block group was ultimately assigned to a single
trauma center based on the minimum drive time. The minimum drive time
was chosen to approximate the trauma center that would be closest to
each block group if resident was transported by EMS.
The following code depicts the above. This code is complex and
computations took several hours given the magnitude of
origin-destination pairs. Therefore, the code is displayed below for
reference but will not run. The output is saved as an RData file for
direct use in subsequent sections. A sample of the output of this file
is shown below.
################################################################################
# Project: Trauma Transportation Security and Follow Up
# Script: Robust Transit Time Matrix Creation
# Purpose:
# Create a travel time matrix accross multiple days and times using previous
# analysis
#
# Author: Brayden Seal
# Created: 12-26-2025
# Updated: X
# Notes:
# this uses r5r for matrix calculations which needs JDK21 downloaded
#
################################################################################
###-------------------------------Set Up-------------------------------------###
library(matrixStats)
library(SpatialAcc)
library(leaflet)
library(leafsync)
library(tidyverse)
library(tidycensus)
library(tmap)
library(RColorBrewer)
library(rmapshaper)
library(tigris)
library(units)
library(mapboxapi)
library(sf)
library(data.table)
library(ggplot2)
library(dplyr)
library(tidytransit)
library(gtfsrouter)
library(purrr)
library(tidyr)
options(java.parameters = '-Xmx12G') #ensures appropriate memory allocated for java
#must be done prior to loading r5r package
Sys.setenv(JAVA_HOME = system("/usr/libexec/java_home -v 21", intern = TRUE)) #specify location and use of JDK 21
Sys.getenv("JAVA_HOME")
system("java -version")
library(r5r)
###--------------------------------Data--------------------------------------###
# A road network data set from OpenStreetMap in .pbf format (mandatory)
# A public transport feed in GTFS.zip format
setwd("~/Desktop/Trauma Transportation/Trauma Follow Up and Transportation Security/Robust TTM Creation")
load('base_maps.RData')
load('origins-destinations.RData')
load('origins_mindrive.RData')
mb_access_token("pk.eyJ1IjoiZ2hvc3Q0NDA4IiwiYSI6ImNtajlqd2l0bTA1eGMzc3B3dzk2YWJwYWoifQ.cWMFPBXqJQfQ0cb68L4Xug", install = T)
###--------------------------Route Construction------------------------------###
data_path <- "~/Desktop/Trauma Transportation/Trauma Follow Up and Transportation Security/Robust TTM Creation/transit_files"
#list.files(data_path)
r5r_network <- build_network(data_path = data_path)
###--------------------------------Test--------------------------------------###
#read dates
# read the GTFS feed
#gtfs_CTA <- read_gtfs('~/Desktop/GIS/transit_files/CTA.zip')
#gtfs_Metra <- read_gtfs('~/Desktop/GIS/transit_files/Metra.zip')
#gtfs_PACE <- read_gtfs('~/Desktop/GIS/transit_files/PACE.zip')
# get calendar dates (from calendar.txt)
#calendar_dates <- gtfs_CTA$calendar
origin <- data.frame(id = '474 N Lakeshore',
lat = as.numeric(41.89108953920192),
lon = as.numeric(-87.61458686048464))
destination <- data.frame(id = 'Millenium Station',
lat = as.numeric(41.884589597182945),
lon = as.numeric(-87.6247049739245))
# set departure datetime input
mode <- c("CAR")
max_walk_time <- 30 # minutes
max_trip_duration <- 120 # minutes
departure_datetime <- as.POSIXct("16-12-2025 12:00:00",
format = "%d-%m-%Y %H:%M:%S")
ttm_test <- travel_time_matrix(
r5r_network,
origins = origin,
destinations = sfh,
mode = mode,
time_window = 60,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
max_trip_duration = max_trip_duration
)
# calculate detailed itineraries
ttm_test <- detailed_itineraries(
r5r_network,
origins = origin,
destinations = destination,
mode = mode,
time_window = 60,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
###----------------------------Input Creations-------------------------------###
#create destinations data frame
adult_level_one$id <- adult_level_one$facility
destination <- adult_level_one %>%
select(id, geometry)
st_crs(destination) #needs to be WGS 84
# set departure datetime input
mode <- c("WALK", 'TRANSIT')
max_walk_time <- 30 # minutes
max_trip_duration <- 120 # minutes
departure_datetime <- as.POSIXct("18-12-2025 16:00:00",
format = "%d-%m-%Y %H:%M:%S")
###---------------------Public Transit Matrix Creations----------------------###
#run this code with sequential modifications to the departure time and save after
#each run to create multiple data frames
#UCM travel time matrix
ucm <- destination %>%
filter(id == 'University of Chicago Emergency Department and Trauma Center')
ttm_ucm_18_16 <- detailed_itineraries(
r5r_network,
origins = ucm_mindrive,
destinations = ucm,
mode = mode,
time_window = 60,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE)
#Christ travel time matrix
christ <- destination %>%
filter(id == 'Advocate Christ Medical Center')
ttm_christ_18_16 <- detailed_itineraries(
r5r_network,
origins = christ_mindrive,
destinations = christ,
mode = mode,
time_window = 60,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Masonic travel time matrix
masonic <- destination %>%
filter(id == 'Advocate Illinois Masonic Medical Center')
ttm_masonic_18_16 <- detailed_itineraries(
r5r_network,
origins = masonic_mindrive,
destinations = masonic,
mode = mode,
time_window = 60,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#County travel time matrix
cook <- destination %>%
filter(id == 'John H. Stroger, Jr. Hospital of Cook County')
ttm_cook_18_16 <- detailed_itineraries(
r5r_network,
origins = cook_mindrive,
destinations = cook,
mode = mode,
time_window = 60,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#NWM travel time matrix
nmh <- destination %>%
filter(id == 'Northwestern Memorial Hospital')
ttm_nmh_18_16 <- detailed_itineraries(
r5r_network,
origins = nmh_mindrive,
destinations = nmh,
mode = mode,
time_window = 60,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#St. Francis time matrix
sfh <- destination %>%
filter(id == 'Ascension Saint Francis - Emergency Room')
ttm_sfh_18_16 <- detailed_itineraries(
r5r_network,
origins = sfh_mindrive,
destinations = sfh,
mode = mode,
time_window = 60,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Mount Sinai time matrix
msh <- destination %>%
filter(id == 'Mount Sinai Hospital')
ttm_msh_18_16 <- detailed_itineraries(
r5r_network,
origins = msh_mindrive,
destinations = msh,
mode = mode,
time_window = 60,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Loyola travel time matrix
loyola <- destination %>%
filter(id == 'Loyola University Medical Center')
ttm_loyola_18_16 <- detailed_itineraries(
r5r_network,
origins = loyola_mindrive,
destinations = loyola,
mode = mode,
time_window = 60,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
#Lutheran travel time matrix
lutheran <- destination %>%
filter(id == 'Advocate Lutheran General Hospital')
ttm_lutheran_18_16 <- detailed_itineraries(
r5r_network,
origins = lutheran_mindrive,
destinations = lutheran,
mode = mode,
time_window = 60,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
ttm_18_16 <- bind_rows(ttm_lutheran_18_16,
ttm_loyola_18_16,
ttm_msh_18_16,
ttm_sfh_18_16,
ttm_nmh_18_16,
ttm_cook_18_16,
ttm_masonic_18_16,
ttm_christ_18_16,
ttm_ucm_18_16)
save(ttm_18_16, file = "18_16_ttm.RData")
ttm_final_raw <- bind_rows(ttm_16_8,
ttm_16_12,
ttm_16_16,
ttm_17_08,
ttm_17_12,
ttm_17_16,
ttm_18_08,
ttm_18_12,
ttm_18_16)
save(ttm_final_raw, file = "ttm_final_raw.RData")
###-----------------------Drive Time Matrix Creations------------------------###
readRenviron("~/.Renviron") #mapbox api use
mode <- c("CAR")
max_walk_time <- 30 # minutes
max_trip_duration <- 120 # minutes
departure_datetime <- as.POSIXct("18-12-2025 16:00:00",
format = "%d-%m-%Y %H:%M:%S")
lutheran_mindrive_dtm <- lutheran_mindrive %>%
filter(id != "170311505022") #for some reason mapbox cannot calculate drive time for this block group
# 1) Build destinations + their matching origins in ONE place (paired by name)
pairs <- tibble(
site = c("ucm","christ","masonic","cook","nmh","sfh","msh","loyola","lutheran"),
origins = list(
ucm_mindrive,
christ_mindrive,
masonic_mindrive,
cook_mindrive,
nmh_mindrive,
sfh_mindrive,
msh_mindrive,
loyola_mindrive,
lutheran_mindrive_dtm
),
destinations = list(
destination %>% filter(id == "University of Chicago Emergency Department and Trauma Center"),
destination %>% filter(id == "Advocate Christ Medical Center"),
destination %>% filter(id == "Advocate Illinois Masonic Medical Center"),
destination %>% filter(id == "John H. Stroger, Jr. Hospital of Cook County"),
destination %>% filter(id == "Northwestern Memorial Hospital"),
destination %>% filter(id == "Ascension Saint Francis - Emergency Room"),
destination %>% filter(id == "Mount Sinai Hospital"),
destination %>% filter(id == "Loyola University Medical Center"),
destination %>% filter(id == "Advocate Lutheran General Hospital")
)
)
#functions for crating r5r and mapbox (traffic) drivetime matrix
r5r_drive <- function(origins_df, destinations_df) {
detailed_itineraries(
r5r_network,
origins = origins_df,
destinations = destinations_df,
mode = mode,
time_window = time_window,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
}
mapbox_drive <- function(origins_df, destinations_df) {
mb_matrix(origins = origins_df,
destinations = destinations_df,
profile = "driving-traffic",
output = "duration")
}
#runs through each origin-destination pairing to create drive time and traffic times
dtm_long <- pairs %>%
mutate(
dtm = pmap(list(origins, destinations), r5r_drive),
dtm_traffic = pmap(list(origins, destinations), mapbox_drive),
obj_name = paste0("dtm_", site, "_")
)
dtm_long <- dtm_long %>%
mutate(
dtm = map2(
dtm,
dtm_traffic,
~ {
stopifnot(nrow(.x) == length(.y)) #ensures correct pairings
.x %>% mutate(drive_time_traffic = as.numeric(.y))
}))
dtm_final_raw <- bind_rows(dtm_long$dtm)
#reintroduce the block group that mapbox could not calculate
final_row <- lutheran_mindrive %>%
filter(id == "170311505022")
final_entry <- detailed_itineraries(
r5r_network,
origins = final_row,
destinations = lutheran,
mode = mode,
time_window = time_window,
departure_datetime = departure_datetime,
max_walk_time = max_walk_time,
shortest_path = FALSE
)
final_entry$drive_time_traffic <- 22.3
dtm_final_raw <- bind_rows(dtm_final_raw, final_entry)
save(dtm_final_raw, file = "dtm_final_raw.RData")
###-------------------------Clean Travel Time Data---------------------------###
process_ttm <- function(df) {
df2 <- df %>%
mutate(
walk = if_else(mode == "WALK", 1, 0),
transfer = if_else(wait > 0, 1, 0),
bus = if_else(mode == "BUS", 1, 0),
cta_train = if_else(mode == "SUBWAY", 1, 0),
metra_train = if_else(mode == "RAIL", 1, 0)
)
walk_summary <- df2 %>%
st_drop_geometry() %>%
filter(mode == "WALK") %>%
group_by(from_id, option) %>%
summarise(
total_walk_time = sum(segment_duration, na.rm = TRUE),
total_walk_distance = sum(distance, na.rm = TRUE),
.groups = "drop"
)
wait_summary <- df2 %>%
st_drop_geometry() %>%
group_by(from_id, option) %>%
summarise(
wait_total = sum(wait, na.rm = TRUE),
total_transfers = sum(transfer, na.rm = TRUE),
total_bus_trips = sum(bus, na.rm = TRUE),
total_cta_train_trips = sum(cta_train, na.rm = TRUE),
total_metra_train_trips = sum(metra_train, na.rm = TRUE),
number_of_legs = n(),
.groups = "drop"
)
df3 <- df2 %>%
left_join(walk_summary, by = c("from_id", "option")) %>%
left_join(wait_summary, by = c("from_id", "option"))
final <- df3 %>%
st_drop_geometry() %>%
group_by(from_id, to_id) %>%
summarise(
number_of_options = max(option),
avg_tt = mean(total_duration, na.rm = TRUE),
avg_td = mean(total_distance, na.rm = TRUE),
avg_walk_time = mean(total_walk_time, na.rm = TRUE),
avg_walk_dist = mean(total_walk_distance, na.rm = TRUE),
avg_wait_time = mean(wait_total, na.rm = TRUE),
avg_transfers = mean(total_transfers, na.rm = TRUE),
avg_bus_trips = mean(total_bus_trips, na.rm = TRUE),
avg_cta_train_trips = mean(total_cta_train_trips, na.rm = TRUE),
avg_metra_train = mean(total_metra_train_trips, na.rm = TRUE),
avg_legs = mean(number_of_legs, na.rm = TRUE),
.groups = "drop"
)
final <- final %>%
rename(GEOID = from_id)
return(final)
}
ttm_16_12_clean <- process_ttm(ttm_16_12)
ttm_16_16_clean <- process_ttm(ttm_16_16)
ttm_16_08_clean <- process_ttm(ttm_16_8)
ttm_17_08_clean <- process_ttm(ttm_17_08)
ttm_17_12_clean <- process_ttm(ttm_17_12)
ttm_17_16_clean <- process_ttm(ttm_17_16)
ttm_18_08_clean <- process_ttm(ttm_18_08)
ttm_18_12_clean <- process_ttm(ttm_18_12)
ttm_18_16_clean <- process_ttm(ttm_18_16)
ttm_sum <- bind_rows(ttm_16_12_clean,
ttm_16_16_clean,
ttm_16_08_clean,
ttm_17_08_clean,
ttm_17_12_clean,
ttm_17_16_clean,
ttm_18_08_clean,
ttm_18_12_clean,
ttm_18_16_clean)
ttm_clean <- ttm_sum %>%
group_by(GEOID, to_id) %>%
summarise(
avg_number_of_options = mean(number_of_options, na.rm = TRUE),
avg_tt = mean(avg_tt, na.rm = TRUE),
avg_td = mean(avg_td, na.rm = TRUE),
avg_walk_time = mean(avg_walk_time, na.rm = TRUE),
avg_walk_dist = mean(avg_walk_dist, na.rm = TRUE),
avg_wait_time = mean(avg_wait_time, na.rm = TRUE),
avg_transfers = mean(avg_transfers, na.rm = TRUE),
avg_bus_trips = mean(avg_bus_trips, na.rm = TRUE),
avg_cta_train_trips = mean(avg_cta_train_trips, na.rm = TRUE),
avg_metra_train = mean(avg_metra_train, na.rm = TRUE),
avg_legs = mean(avg_legs, na.rm = TRUE))
save(ttm_clean, file = "ttm_clean.RData")
#drive time cleaning
dtm_clean <- dtm_final_raw %>%
st_drop_geometry() %>%
rename(
drive_time = total_duration,
drive_distance = total_distance,
GEOID = from_id) %>%
select(GEOID, drive_time, drive_time_traffic, drive_distance)
save(dtm_clean, file = "dtm_clean.RData")
###-------------------------Create Final Data Frame--------------------------###
final_min_time_robust <- ttm_clean %>%
full_join(dtm_clean, by = "GEOID")
final_min_time_robust <- chi_bgs %>%
left_join(final_min_time_robust, by = 'GEOID')
save(final_min_time_robust, file = "final_min_time_robust.RData")
Social Vulnerability Index
The social vulnerability index (SVI) is a measure of the demographic and socioeconomic factors that adversely affect communities(Flanagan et al. 2011). The measure was released by the CDC in 2011 and is derived from 16 U.S. census variables reflecting socioeconomic status, household characteristics, racial and ethnic minority status, housing type, and transportation indexed as percentiles relative to the state or country.
The below map reflects the SVI from 2022 covering Illinois. Levels of vulnerability are defined by quartiles (e.g. “very high vulnerability” refers to an SVI ≥ 0.75).
Methods language: